home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tpl60n19.zip / TESTPRGS.ZIP / HEAPTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-14  |  5KB  |  157 lines
  1. PROGRAM HeapTest;  { Copyright (c) 1992,1993 Norbert Juffa }
  2.  
  3. {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R-,S-,V-,X-}
  4. {$M 4096,0,655360}
  5.  
  6. USES Time;
  7.  
  8. VAR Dummy,Start, LoopTime,LoopTime2: LONGINT;
  9.     Delta, TotalTime: LONGINT;
  10.     L,Choice,K,T: WORD;
  11.     BlkPtr:  ARRAY [1..1000] OF POINTER;
  12.     BlkSize: ARRAY [1..1000] OF WORD;
  13.     Permutation: ARRAY [1..1000] OF WORD;
  14.  
  15. BEGIN
  16.    WriteLn ('Test of TP heap functions');
  17.    WriteLn;
  18.    TotalTime := 0;
  19.    RandSeed := 997;
  20.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  21.    Start := Clock;
  22.    FOR L := 1 TO 1000 DO BEGIN
  23.    END;
  24.    LoopTime := Clock-Start;
  25.    FOR L := 1 TO 1000 DO BEGIN
  26.       BlkSize [L] := Random (512) + 1;
  27.    END;
  28.    Write ('Allocating 1000 blocks at the end of the heap: ');
  29.    Start := Clock;
  30.    FOR L := 1 TO 1000 DO BEGIN
  31.       GetMem (BlkPtr [L], BlkSize [L]);
  32.    END;
  33.    Delta := Clock-Start-LoopTime;
  34.    Inc (TotalTime, Delta);
  35.    WriteLn (Delta:5, ' ms');
  36.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  37.    Write ('Deallocating same 1000 blocks in reverse order:');
  38.    Start := Clock;
  39.    FOR L := 1 TO 1000 DO BEGIN
  40.       FreeMem (BlkPtr [L], BlkSize [L]);
  41.    END;
  42.    Delta := Clock-Start-LoopTime;
  43.    Inc (TotalTime, Delta);
  44.    WriteLn (Delta:5, ' ms');
  45.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  46.    Write ('Allocating 1000 blocks at the end of the heap: ');
  47.    Start := Clock;
  48.    FOR L := 1 TO 1000 DO BEGIN
  49.       GetMem (BlkPtr [L], BlkSize [L]);
  50.    END;
  51.    Delta := Clock-Start-LoopTime;
  52.    Inc (TotalTime, Delta);
  53.    WriteLn (Delta:5, ' ms');
  54.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  55.    FOR L := 1 TO 1000 DO BEGIN
  56.       Permutation [L] := L;
  57.    END;
  58.    Start := Clock;
  59.    FOR L := 1000 DOWNTO 1 DO BEGIN
  60.       Choice := Random (L)+1;
  61.       K := Permutation [Choice];
  62.       Permutation [Choice] := Permutation [L];
  63.    END;
  64.    LoopTime2 := Clock - Start;
  65.    FOR L := 1 TO 1000 DO BEGIN
  66.       Permutation [L] := L;
  67.    END;
  68.    Write ('Deallocating same 1000 blocks at random:       ');
  69.    Start := Clock;
  70.    FOR L := 1000 DOWNTO 1 DO BEGIN
  71.       Choice := Random (L)+1;
  72.       K := Permutation [Choice];
  73.       Permutation [Choice] := Permutation [L];
  74.       FreeMem (BlkPtr [K], BlkSize [K]);
  75.    END;
  76.    Delta := Clock - Start - LoopTime2;
  77.    Inc (TotalTime, Delta);
  78.    WriteLn (Delta:5, ' ms');
  79.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  80.    Write ('Allocating 1000 blocks at the end of the heap: ');
  81.    Start := Clock;
  82.    FOR L := 1 TO 1000 DO BEGIN
  83.       GetMem (BlkPtr [L], BlkSize [L]);
  84.    END;
  85.    Delta := Clock-Start-LoopTime;
  86.    Inc (TotalTime, Delta);
  87.    WriteLn (Delta:5, ' ms');
  88.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  89.    FOR L := 1 TO 1000 DO BEGIN
  90.       Permutation [L] := L;
  91.    END;
  92.    Start := Clock;
  93.    FOR L := 1000 DOWNTO 1 DO BEGIN
  94.       Choice := Random (L)+1;
  95.       K := Permutation [Choice];
  96.       T:= Permutation [L];
  97.       Permutation [L] := Permutation [Choice];
  98.       Permutation [Choice] := T;
  99.    END;
  100.    LoopTime2 := Clock - Start;
  101.    FOR L := 1 TO 1000 DO BEGIN
  102.       Permutation [L] := L;
  103.    END;
  104.    Write ('Deallocating 500 blocks at random:             ');
  105.    Start := Clock;
  106.    FOR L := 1000 DOWNTO 501 DO BEGIN
  107.       Choice := Random (L)+1;
  108.       K := Permutation [Choice];
  109.       T:= Permutation [L];
  110.       Permutation [L] := Permutation [Choice];
  111.       Permutation [Choice] := T;
  112.       SYSTEM.FreeMem (BlkPtr [K], BlkSize [K]);
  113.    END;
  114.    Delta := Clock-Start-LoopTime2;
  115.    Inc (TotalTime, Delta);
  116.    WriteLn (Delta:5, ' ms');
  117.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  118.    Start := Clock;
  119.    FOR L := 1 TO 1000 DO BEGIN
  120.       Dummy := MaxAvail;
  121.    END;
  122.    Delta := Clock-Start;
  123.    Inc (TotalTime, (Delta + 5) DIV 10);
  124.    WriteLn ('1000 calls to MaxAvail:                        ', Delta:5, ' ms');
  125.    Start := Clock;
  126.    FOR L := 1 TO 1000 DO BEGIN
  127.       Dummy := MemAvail;
  128.    END;
  129.    Delta := Clock - Start;
  130.    Inc (TotalTime, (Delta + 5) DIV 10);
  131.    WriteLn ('1000 calls to MemAvail:                        ', Delta:5, ' ms');
  132.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  133.    Write ('Reallocating deallocated 500 blocks at random: ');
  134.    Start := Clock;
  135.    FOR L := 501 TO 1000 DO BEGIN
  136.       GetMem (BlkPtr [Permutation [L]], BlkSize [Permutation [L]]);
  137.    END;
  138.    Delta := Clock-Start-LoopTime;
  139.    Inc (TotalTime, Delta);
  140.    WriteLn (Delta:5, ' ms');
  141.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  142.    Write ('Deallocating all 1000 blocks at random:        ');
  143.    Start := Clock;
  144.    FOR L := 1000 DOWNTO 1 DO BEGIN
  145.       FreeMem (BlkPtr [L], BlkSize [L]);
  146.    END;
  147.    Delta := Clock-Start-LoopTime;
  148.    Inc (TotalTime, Delta);
  149.    WriteLn (Delta:5, ' ms');
  150.    WriteLn ('MaxAvail: ', MaxAvail, '   MemAvail: ', MemAvail);
  151.    WriteLn;
  152.    WriteLn ('Total time for benchmark: ', TotalTime, ' ms');
  153. END.
  154.  
  155.  
  156.  
  157.